SqlExport.bas
Language: Visual Basic Module
Last Modified: 2020-06-27 1:58:30 PM UTC
File Size: 22420 bytes
Last Modified: 2020-06-27 1:58:30 PM UTC
File Size: 22420 bytes
http://www.penguinstew.ca/example/ExcelSQLExport/SqlExport.bas
AttributeVB_Name=SqlExport
OptionExplicit
SubSqlExport
DimmonthsAsVector
DimcatagoriesAsVector
DimspecialAccountsAsVector
DimtransAsVector
Initalizevectors
Setmonths=NewVector
Setcatagories=NewVector
SetspecialAccounts=NewVector
Settrans=NewVector
Setupvectortypes
monthsSetTypeNewmonth
catagoriesSetTypeNewCatagory
specialAccountsSetTypeNewspecialAccount
transSetTypeNewTransaction
DimtransSavingCheuqeAsInteger
DimtransSavingCashAsInteger
DimtransCheuqeSavingAsInteger
DimtransCheuqeCashAsInteger
DimtransCashSavingAsInteger
DimtransCashCheuqeAsInteger
DimcashDebitAsInteger
DimsysCatAsCatagory
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
transSavingCheuqe=sysCatCatagoryId
sysCatName=TransferSavingstoChequing
sysCatcolour=bebebe
sysCatToAccount=1
sysCatFromAccount=0
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
transSavingCash=sysCatCatagoryId
sysCatName=TransferSavingstoCash
sysCatcolour=bebebe
sysCatToAccount=2
sysCatFromAccount=0
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
transCheuqeSaving=sysCatCatagoryId
sysCatName=TransferChequingtoSavings
sysCatcolour=bebebe
sysCatToAccount=0
sysCatFromAccount=1
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
transCheuqeCash=sysCatCatagoryId
sysCatName=TransferChequingtoCash
sysCatcolour=bebebe
sysCatToAccount=2
sysCatFromAccount=1
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
transCashSaving=sysCatCatagoryId
sysCatName=TransferCashtoSavings
sysCatcolour=bebebe
sysCatToAccount=0
sysCatFromAccount=2
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
transCashCheuqe=sysCatCatagoryId
sysCatName=TransferCashtoChequing
sysCatcolour=bebebe
sysCatToAccount=1
sysCatFromAccount=2
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
sysCatName=SpecialAccountCredit
sysCatcolour=bebebe
sysCatToAccount=3
sysCatFromAccount=4
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
sysCatName=SpecialAccountDebit
sysCatcolour=bebebe
sysCatToAccount=4
sysCatFromAccount=3
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
sysCatName=SpecialAccountCreditfromSavings
sysCatcolour=bebebe
sysCatToAccount=3
sysCatFromAccount=0
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
sysCatName=SpecialAccountDebittoSavings
sysCatcolour=bebebe
sysCatToAccount=0
sysCatFromAccount=3
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
sysCatName=SpecialAccountCreditfromChequing
sysCatcolour=bebebe
sysCatToAccount=3
sysCatFromAccount=1
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
sysCatName=SpecialAccountDebittoChequing
sysCatcolour=bebebe
sysCatToAccount=1
sysCatFromAccount=3
sysCatInUse=True
sysCatIsSystem=True
catagoriesAddsysCat
SetsysCat=NewCatagory
sysCatCatagoryId=catagoriescount1
cashDebit=sysCatCatagoryId
sysCatName=Cashdebit
sysCatcolour=bebebe
sysCatToAccount=4
sysCatFromAccount=2
sysCatInUse=True
sysCatIsSystem=False
catagoriesAddsysCat
DimSheetAsWorksheet
ForEachSheetInWorksheets
DimiAsInteger
DimjAsInteger
DimkAsInteger
SheetActivate
SkipthestartingGraphsheets
IfNotSheetName=BudgetAndNotSheetName=BalanceHistoryAndNotSheetName=BillHistory_
AndNotSheetName=TotalHistoryAndNotSheetName=ExpenseHistoryThen
Clearcatagoryusage
Forj=0Tocatagoriescount1
IfNotcatagoriesGetAtjIsSystemThen
catagoriesGetAtjInUse=False
EndIf
Nextj
Getstartingaccountvalues
DimstartCheuqAsDouble
DimstartSaveAsDouble
DimstartCashAsDouble
startCheuq=Cells1Gvalue
startSave=Cells1Hvalue
startCash=Cells1Ivalue
Addmonthtovector
DimmonthAsmonth
Setmonth=Newmonth
monthMonthId=monthscount1
monthMonthDate=Cells1Avalue
monthStartCheuqing=roundstartCheuq
monthStartSavings=roundstartSave
monthstartCash=roundstartCash
monthsAddmonth
Setupvectorforcatagoriesinthismonth
DimlocalCatagoriesAsVector
SetlocalCatagories=NewVector
localCatagoriesSetTypeNewCatagory
Setupvectorforspecialaccountsinthismonth
DimlocalSpecialAccountsAsVector
SetlocalSpecialAccounts=NewVector
localSpecialAccountsSetTypeNewspecialAccount
Setupcatagoryspecialaccounttypevariables
DimfromAccntAsInteger
DimtoAccntAsInteger
DimisSpecialAsBoolean
fromAccnt=4
toAccnt=0
isSpecial=False
Getthelastcatagoryrow
DimFinalCatagoryAsInteger
FinalCatagory=CellsRowscount12EndxlUpRow
Fori=1ToFinalCatagory
DimcolourAsString
DimcellValueAsString
Getthecolourofthecellandconverttohexstring
colour=HexCellsiLInteriorColor
Getthetextofthecell
cellValue=CellsiLvalue
cellValue=LCasecellValue
Startofexpenses
IfcellValue=expensessThen
fromAccnt=1
toAccnt=4
EndIf
Savingsaccountexpenses
IfcellValue=servicesOrcellValue=goodsThen
fromAccnt=0
EndIf
Startofspecialaccounts
IfcellValue=totalAndcolour=0Then
isSpecial=True
EndIf
Skipblankcellssumrowsandcellswithoutcolour
IfNotcellValue=AndNotcellValue=incomeAndNotcellValue=expensesAnd_
NotcellValue=totalAndNotcolour=FFFFFFThen
IfNotisSpecialThen
DimfoundAsBoolean
found=False
Seeiftheresalreadyacatagorywithamatchingname
IfNotcatagoriesIsEmptyThen
Forj=0Tocatagoriescount1
IfcatagoriesGetAtjName=StrConvescapecellValuevbProperCaseThen
found=True
catagoriesGetAtjInUse=True
localCatagoriesAddcatagoriesGetAtj
ExitFor
EndIf
Nextj
EndIf
Addanewoneifnotfound
IfNotfoundThen
DimcatAsCatagory
Setcat=NewCatagory
catCatagoryId=catagoriescount1
catName=StrConvescapecellValuevbProperCase
catcolour=GetRgbColourcolour
catFromAccount=fromAccnt
catToAccount=toAccnt
catInUse=True
catagoriesAddcat
localCatagoriesAddcat
EndIf
Else
DimammountAsDouble
ammount=CellsiNvalue
Usethesecondcelltogetthelistofrelatedtransactions
DimspecTransAsString
DimspecArrayAsString
specTrans=CellsiMFormula
specTrans=ReplacespecTrans=
specTrans=ReplacespecTransC
specTrans=ReplacespecTransE
specArray=SplitspecTrans
DimspecAsspecialAccount
Setspec=NewspecialAccount
specSpecialAccountMonthId=specialAccountscount1
specMonthId=monthMonthId
specName=escapecellValue
specamount=roundammount
specisNew=True
DimhighestAcntIdAsInteger
found=False
highestAcntId=0
IfNotspecialAccountsIsEmptyThen
Forj=0TospecialAccountscount1
IfspecialAccountsGetAtjSpecialAccountId>=highestAcntIdThen
highestAcntId=specialAccountsGetAtjSpecialAccountId1
EndIf
IfspecialAccountsGetAtjName=specNameThen
found=True
specisNew=False
specSpecialAccountId=specialAccountsGetAtjSpecialAccountId
ExitFor
EndIf
Nextj
EndIf
IfNotfoundThen
specSpecialAccountId=highestAcntId
EndIf
DimspecRowAsVariant
ForEachspecRowInspecArray
specrowNumbersAddCIntspecRow
NextspecRow
specialAccountsAddspec
localSpecialAccountsAddspec
EndIf
EndIf
IfcellValue=servicesOrcellValue=goodsThen
fromAccnt=1
EndIf
Nexti
DimFinalTransactionAsInteger
FinalTransaction=CellsRowscount7EndxlUpRow
DimcurrentDateAsDate
Fori=3ToFinalTransaction
IfNotCellsiAvalue=Then
currentDate=GetCorrectDateCellsiAvalue
EndIf
DimcheuqeFormulaAsString
DimsaveFormulaAsString
DimcashFormulaAsString
cheuqeFormula=CellsiGFormula
saveFormula=CellsiHFormula
cashFormula=CellsiIFormula
DimtoCheuqeAsBoolean
DimfromCheuqeAsBoolean
DimtoSaveAsBoolean
DimfromSaveAsBoolean
DimtoCashAsBoolean
DimfromCashAsBoolean
toCheuqe=NotInStrcheuqeFormula=0
fromCheuqe=NotInStrcheuqeFormula=0
toSave=NotInStrsaveFormula=0
fromSave=NotInStrsaveFormula=0
toCash=NotInStrcashFormula=0
fromCash=NotInStrcashFormula=0
DimIsCashAsBoolean
IsCash=toCashOrfromCash
DimvalueColumnAsString
DimammountColumnAsString
IfNotCellsiBvalue=Then
valueColumn=B
ammountColumn=C
ElseIfNotCellsiDvalue=Then
valueColumn=D
ammountColumn=E
EndIf
IfNotvalueColumn=Then
colour=HexCellsivalueColumnInteriorColor
cellValue=CellsivalueColumnvalue
ammount=CellsiammountColumnvalue
DimTransactionAsTransaction
IfNotcolour=FFFFFFThen
colour=GetRgbColourcolour
SetTransaction=NewTransaction
TransactionMonthId=monthMonthId
TransactionTransDate=currentDate
TransactionDescription=escapecellValue
Transactionamount=roundammount
TransactionCatagoryId=0
TransactionRecurringExpenseId=0
IfIsCashThen
Cashtransaction
TransactionCatagoryId=cashDebit
Else
Forj=0TolocalCatagoriescount1
IflocalCatagoriesGetAtjcolour=colourThen
TransactionCatagoryId=localCatagoriesGetAtjCatagoryId
ExitFor
EndIf
Nextj
EndIf
TransactionSpecialAccountId=0
Forj=0TolocalSpecialAccountscount1
Fork=0TolocalSpecialAccountsGetAtjrowNumberscount1
Ifi=localSpecialAccountsGetAtjrowNumbersGetAtkThen
TransactionSpecialAccountId=localSpecialAccountsGetAtjSpecialAccountMonthId
EndIf
Nextk
Nextj
IfTransactionCatagoryId=0Then
MsgBoxTransactionTransactionDescriptionhasnocatagoryskipping
Else
transAddTransaction
EndIf
ElseIfNotCellsiBvalue=AndNotCellsiDvalue=Then
transfer
SetTransaction=NewTransaction
TransactionMonthId=monthMonthId
TransactionTransDate=currentDate
TransactionDescription=escapecellValue
Transactionamount=roundammount
TransactionRecurringExpenseId=0
TransactionSpecialAccountId=0
IffromSaveAndtoCheuqeThen
TransactionCatagoryId=transSavingCheuqe
ElseIffromSaveAndtoCashThen
TransactionCatagoryId=transSavingCash
ElseIffromCheuqeAndtoSaveThen
TransactionCatagoryId=transCheuqeSaving
ElseIffromCheuqeAndtoCashThen
TransactionCatagoryId=transCheuqeCash
ElseIffromCashAndtoSaveThen
TransactionCatagoryId=transCashSaving
ElseIffromCashAndtoCheuqeThen
TransactionCatagoryId=transCashCheuqe
EndIf
IfTransactionCatagoryId=0Then
MsgBoxTransactionTransactionDescriptionhasnocatagoryskipping
Else
transAddTransaction
EndIf
EndIf
EndIf
Nexti
EndIf
NextSheet
outputSqlmonthscatagoriesspecialAccountstrans
MsgBoxDone
EndSub
SuboutputSqlByRefmonthsAsVectorByRefcatagoriesAsVectorByRefspecialAccountsAsVectorByReftransAsVector
DimfileAsString
DimiAsInteger
file=ThisWorkbookPath\sqlExportsql
OnErrorResumeNext
Killfile
OnErrorGoTo0
OpenfileForOutputAs1
Print1DELETEFROM[Transactions]
Print1DBCCCHECKIDENT[Transactions]RESEED1
Print1DELETEFROM[BudgetCategories]
Print1DBCCCHECKIDENT[BudgetCategories]RESEED1
Print1DELETEFROM[BudgetMonths]
Print1DBCCCHECKIDENT[BudgetMonths]RESEED1
Print1DELETEFROM[Categories]
Print1DBCCCHECKIDENT[Categories]RESEED1
Print1DELETEFROM[SpecialAccountMonths]
Print1DBCCCHECKIDENT[SpecialAccountMonths]RESEED1
Print1DELETEFROM[SpecialAccounts]
Print1DBCCCHECKIDENT[SpecialAccounts]RESEED1
Print1DELETEFROM[Months]
Print1DBCCCHECKIDENT[Months]RESEED1
Print1DELETEFROM[BudgetTypes]
Print1DBCCCHECKIDENT[BudgetTypes]RESEED1
Print1
IfNotmonthsIsEmptyThen
Print1SETIDENTITY_INSERT[Months]ON
Fori=0Tomonthscount1
Print1monthsGetAtiToSQL
Nexti
Print1SETIDENTITY_INSERT[Months]OFF
Print1
EndIf
IfNotcatagoriesIsEmptyThen
Print1SETIDENTITY_INSERT[Categories]ON
Fori=0Tocatagoriescount1
Print1catagoriesGetAtiToSQL
Nexti
Print1SETIDENTITY_INSERT[Categories]OFF
Print1
EndIf
IfNotspecialAccountsIsEmptyThen
Print1SETIDENTITY_INSERT[SpecialAccounts]ON
Fori=0TospecialAccountscount1
IfspecialAccountsGetAtiisNewThen
Print1specialAccountsGetAtiToSQL
EndIf
Nexti
Print1SETIDENTITY_INSERT[SpecialAccounts]OFF
Print1
EndIf
IfNotspecialAccountsIsEmptyThen
Print1SETIDENTITY_INSERT[SpecialAccountMonths]ON
Fori=0TospecialAccountscount1
Print1specialAccountsGetAtiToMonthSql
Nexti
Print1SETIDENTITY_INSERT[SpecialAccountMonths]OFF
Print1
EndIf
IfNottransIsEmptyThen
Fori=0Totranscount1
Print1transGetAtiToSQL
Nexti
EndIf
Close1
EndSub
FunctionGetCorrectDatedateValueAsStringAsDate
DimtempDateAsDate
DimtempDayAsInteger
DimtempMonthAsInteger
DimtempYearAsInteger
tempDate=dateValue
IfDaytempDate<=12Then
tempDay=DaytempDate
tempMonth=monthtempDate
tempYear=YeartempDate
tempDate=tempMonthtempDaytempYear
EndIf
GetCorrectDate=tempDate
EndFunction
FunctionGetRgbColourbgrColourAsStringAsString
DimrgbColourAsString
DimjAsInteger
DimcolourLeftAsString
DimcolourMidAsString
DimcolourRightAsString
Forj=LenbgrColourTo5
bgrColour=0bgrColour
Nextj
colourLeft=LeftbgrColour2
colourMid=MidbgrColour32
colourRight=RightbgrColour2
GetRgbColour=colourRightcolourMidcolourLeft
EndFunction
FunctionescapelineAsStringAsString
escape=Replaceline
EndFunction
FunctionroundamountAsDoubleAsDouble
round=Formatamount00
EndFunction
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
![[Valid RSS]](/images/valid-rss-rogers.png)
